package VGAP::Tools;

#    VGA Planets PERL Tools module
#    Copyright (C) 2004 Peter Harris and Peter Burns
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License version 2 as
#    published by the Free Software Foundation.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#    This program is currently hosted at http://code.google.com/p/vgapd/

use strict;
use warnings;
use File::Spec;
use vars qw($VERSION);

$VERSION = "0.2.1";

sub GetRaceLongNames(@) {
   my $location = shift;
   my $data;
   my @races = (
      'The Solar Federation',
      'The Lizard Alliance',
      'The Empire of the Birds',
      'The Fascist Empire',
      'The Privateer Bands',
      'The Cyborg',
      'The Crystal Confederation',
      'The Evil Empire',
      'The Robotic Imperium',
      'The Rebel Confederation',
      'The Missing Colonies of Man'
   );
   
  while (defined($location)) {
    if (open FILE, File::Spec->catfile($location, 'race.nm')) {
      sysread(FILE,$data,330,0);
      close FILE;
      @races=unpack 'A30'x 11, $data;
      $location = undef;
    } else {
      $location = shift;
    }
  }
   
  return @races;
} # End GetRaceLongNames sub

sub GetRaceShortNames(@) {
   my $location = shift;
   my $data;
   my @races = (
      'The Feds',
      'The Lizards',
      'The Bird Men',
      'The Fascists',
      'The Privateers',
      'The Cyborg',
      'The Crystal People',
      'The Evil Empire',
      'The Robots',
      'The Rebels',
      'The Colonies'
   );

  while (defined($location)) {
    if (open FILE, File::Spec->catfile($location, 'race.nm')) {
      sysread(FILE,$data,220,330);
      close FILE;
      @races=unpack 'A20'x 11, $data;
      $location = undef;
    } else {
      $location = shift;
    }
  }

  return @races;
} # End GetRaceShortNames sub

sub GetRaceAdjectiveNames(@) {
   my $location = shift;
   my $data;
   my @races = (
      'Fed',
      'Lizard',
      'Bird Man',
      'Fascist',
      'Privateer',
      'Cyborg',
      'Crystalline',
      'Empire',
      'Robotic',
      'Rebel',
      'Colonial'
   );

  while (defined($location)) {
    if (open FILE, File::Spec->catfile($location, 'race.nm')) {
      sysread(FILE,$data,132,550);
      close FILE;
      @races=unpack 'A12'x 11, $data;
      $location = undef;
    } else {
      $location = shift;
    }
  }

  return @races;
} # End GetRaceAdjectiveNames sub


sub GetTurnNumber($) {
  my $gamedir = shift;
  my $data;
  my $file = File::Spec->catfile($gamedir, 'nextturn.hst');

  return -1 if (!-e $file);
  return 0 if (-z $file);
  open(FILE,$file) or die("Failed to open file $file\n");
  binmode FILE;
  sysread FILE,$data,20,0;
  close FILE;
  return unpack('x18S',$data);
} # End GetTurnNumber sub


sub GetTimScore($$) {
  my $gamedir = shift;
  my $arrayref = shift;
  my $scorefile = File::Spec->catfile($gamedir, 'score.log');
  my @row;
  my $count = 0;
  
  if (ref($arrayref)) {
    if (open FILE, $scorefile) {
      while (<FILE>) {
        next if (/^\s*STAR/);
        next if (/^\s*RACE/);
        if (/^ +(.+?) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) *$/) {
          @{$row[$count]} = ($1,$2,$3,$4,$5,$6);
          $count++;
        }
      }
      @$arrayref = @row;
      return 1;
    } else {
      warn("File $scorefile does not exist or could not be opened!\n");
      return 0;
    }
  } else {
    die("GetTimScore requires an array reference as the 2nd parameter!\n");
  }
} #End GetTimScore sub

sub GetPTScore($$) {
  my $gamedir = shift;
  my $hashref = shift;
  my $scorefile = File::Spec->catfile($gamedir, 'ptscore.log');
  my %ptscore;
  my @scoretable;
  my $count = 0;
  
  if (ref($hashref)) {
    if (open FILE, $scorefile) {
      while(<FILE>) {
        if (/^Turn: (\d+)/) {
          $ptscore{"turn"} = $1;
        }
        next if (/^Race/);
        next if (/^-+ *$/);

        if (/^ +(\d+) +(.+?) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) *$/) {
          @{$scoretable[$count]} = ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12,$13);
          $count++;
        }
        
        if (/^ptscore +v([0-9\.]+) *$/i) {
          $ptscore{"version"} = $1;
        }
        
        if (/^ship +slots +: +(\d+) +used, +(\d+) +empty *$/i) {
          $ptscore{"used"} = $1;
          $ptscore{"empty"} = $2;
        }
        @{$ptscore{"scoretable"}} = @scoretable;
      }
      %$hashref = %ptscore;
      return 1;
    } else {
      warn("File $scorefile does not exist or could not be opened.\n");
      return 0;
    }
  } else {
    die("GetPTScore needs a hash reference as 2nd parameter!\n");
  }
} #End GetPTScore sub

1;
